#!/usr/bin/env perl

use strict;
use Data::Dumper;
use feature qw(say);

our $global_data_length = 16;
our $global_code_length = 9; #8
our $global_number_of_alone_bits_in_code = 3; #3
#our $global_number_of_xor_bits = 6;
our $global_number_of_xor_bits = [ 4, 6 ];

#my $ref_code = &get_zero_code;
#my $ref_code = [ 0,1,0,1,0,0,0,0 ];
#print Dumper( &code2int($ref_code) );
#print Dumper( &int2code(80) );
#my $test = int 1/2;
#print Dumper( &code2int(&get_next_code(&int2code(81))) );
#my $test = &if_code_alone_bits( [0,1,0,0,1,0,1,0] );
#my $test = &code_num_of_bits( [0,1,0,0,1,0,1,0] );
#print "$test\n";
#my $text_table = &table2text( $ref_codes_table );
#print $text_table;
#say &codes_eq( [0,1,0,0,1,0,1,0], [0,1,0,0,1,0,1,1] );

my $debug_table = [ [ 0,0,0,1,0,1,0,1 ],
                    [ 0,0,1,0,1,0,0,1 ],
		    [ 0,1,0,0,0,1,0,1 ],
		    [ 0,1,0,0,1,0,1,0 ],
		    [ 0,1,0,1,0,1,0,0 ],
		    [ 1,0,0,1,0,0,1,0 ],
		    [ 0,1,0,1,0,0,0,1 ],
		    [ 1,0,1,0,0,0,0,1 ] ];

my $debug_table_false = [ [ 0,0,0,1,0,1,0,1 ],
                    [ 0,0,1,0,1,0,0,1 ],
		    [ 0,1,0,0,0,1,0,1 ],
		    [ 0,1,0,0,1,0,1,0 ],
		    [ 0,1,0,1,0,1,0,0 ],
		    [ 1,0,0,1,0,0,1,0 ],
		    [ 0,1,0,1,0,0,0,1 ],
		    [ 1,0,1,0,0,0,1,0 ] ];


our $global_count = 0;

our $global_ref_codes_table = &get_codes_table;
my $ref_code_set = &init_code_set;

#ay table2text( $global_ref_codes_table );

#~ say table2text( $debug_table_false );
#~ say &check_code_set( $debug_table_false );
#~ say table2text( $debug_table );
#~ say &check_code_set( $debug_table );

#say &check_code_set( $ref_code_set );

say &table2text( $global_ref_codes_table );

&recursively_rotate_code( $ref_code_set, 0 );

#say &table2text( &get_subtable( $global_ref_codes_table, 5 ) );

sub check_diagonal { #no one xor of above diagonal should match xor on diagonal
	my $ref_table = shift @_;
	my $diagonal_xors = &get_xors_table( $ref_table );
	my $table_length = scalar @$ref_table;
	for ( my $i = 0; $i < $table_length - 2; $i++ ) {
		for ( my $j = $i + 2; $j < $table_length; $j++ ) {
			my $xor = &codes_xor( $ref_table->[$i], $ref_table->[$j] );
			foreach my $ref_code ( @$diagonal_xors ) {
				if ( &codes_eq( $xor, $ref_code ) ) {
					return 0;
				}
			}
		}
	}
	return 1;
}

sub code_and_xor_tables_to_text {
	my $ref_table = shift @_;
	my $ref_xors_table = &get_xors_table( $ref_table );
	my $text;
	my $table_length = scalar @$ref_table;
	for ( my $i = 0; $i < $table_length; $i++ ) {
		if ( $i == 0 ) {
			$text .= &code2string( $ref_table->[$i] ) . "\n";
		} else {
			$text .= &code2string( $ref_table->[$i] ) . "\t" . &code2string( $ref_xors_table->[$i-1] ) . "\n";
		}
	}
	return $text;	
}

sub recursively_rotate_code {
	my $ref_table = shift @_;
	my $index = shift @_;
	my $table_length = scalar @$ref_table;
	foreach my $ref_code ( @{$global_ref_codes_table} ) {
		$ref_table->[$index] = $ref_code;
		my $ref_subtable = &get_subtable( $ref_table, $index );
		if ( !&check_code_set( $ref_subtable ) ) { next }
		if ( $index < $table_length-1 ) {
			&recursively_rotate_code( $ref_table, $index+1 );
		} else {
			if ( &check_code_set( $ref_table ) ) {
				say "=====================\n";
				#say &table2text( $ref_table );
				say &code_and_xor_tables_to_text( $ref_table );
				say "Bingo!";
			}
		}
	}
}

sub get_subtable { 
	my $ref_table = shift @_;
	my $index = shift @_;
	my @table = @$ref_table[0..$index];
	return \@table;
}

sub check_code_set { # return 1 if both codes and xors are unique
	my $ref_table = shift @_;
	my $ref_xors_table = &get_xors_table( $ref_table );
	if ( !&check_table_for_uniq_codes( $ref_table ) ) { return 0; }
	if ( !&check_table_for_num_of_bits($ref_xors_table, $global_number_of_xor_bits) ) { return 0; }
	if ( !&check_table_for_uniq_codes( $ref_xors_table ) ) { return 0; }
	if ( !&check_xor_table_for_paired_bits( $ref_xors_table ) ) { return 0; }
	if ( !&check_diagonal( $ref_table ) ) { return 0; }
	return 1;

}

sub check_xor_table_for_paired_bits { #each "1" should have at least one "1" agjecent
	my $ref_table = shift @_;
	foreach my $ref_code ( @$ref_table ) {
		my $code_length = scalar @$ref_code;
		for ( my $i = 0; $i < $code_length; $i++ ) {
			if ( $i == 0 &&
			     $ref_code->[$i] == 1 &&
			     $ref_code->[$i+1] == 0 ) { return 0; }
			if ( $i > 0 && $i < $code_length-1 &&
			     $ref_code->[$i] == 1 &&
			     $ref_code->[$i-1] == 0 &&
			     $ref_code->[$i+1] == 0 ) { return 0; }
			if ( $i == $code_length-1 &&
			     $ref_code->[$i] == 1 &&
			     $ref_code->[$i-1] == 0 ) { return 0; }
		}
	}
	return 1;
}

#~ sub check_table_for_num_of_bits { # to be used for xors
	#~ my $ref_table = shift @_;
	#~ my $num = shift @_;
	#~ foreach my $ref_code ( @$ref_table ) {
		#~ if ( &code_num_of_bits($ref_code) != $num ) {
			#~ return 0;
		#~ }
	#~ }
	#~ return 1;
#~ }

sub check_table_for_num_of_bits { # to be used for xors
	my $ref_table = shift @_;
	my $ref_nums = shift @_;
	foreach my $ref_code ( @$ref_table ) {
		my $flag = 0;
		foreach my $num ( @$ref_nums ) {
			if ( &code_num_of_bits($ref_code) == $num ) {
				$flag = 1;
			}
		}
		if ( !$flag ) { return 0 };
	}
	return 1;
}

sub get_xors_table {
	my $ref_table = shift @_;
	my $table_length = scalar @$ref_table;
	my @xor_table;
	for ( my $i = 0; $i < $table_length-1; $i++ ) {
		push @xor_table, &codes_xor( $ref_table->[$i], $ref_table->[$i+1] );
	}
	return \@xor_table;
}

sub check_table_for_uniq_codes { # return 1 if all codes in table are uniq
	my $ref_table = shift @_;
	### Check versus duplicated codes
	my $table_length = scalar @$ref_table;
	for ( my $i = 0; $i < $table_length-1; $i++ ) {
		for ( my $j = $i + 1; $j < $table_length ; $j++ ) {
			if ( &codes_eq( $ref_table->[$i], $ref_table->[$j]) == 1 ) {
				return 0;
			}
		}
	}
	return 1;
}

sub codes_eq { # returns 1 if two codes equal
	my $ref_code_1 = shift @_;
	my $ref_code_2 = shift @_;
	for ( my $i = 0; $i < $global_code_length ; $i++ ) {
		if ( $ref_code_1->[$i] != $ref_code_2->[$i] ) {
			return 0;
		}
	}
	return 1;
}

sub init_code_set {
	my @code_set;
	for ( my $i = 0; $i < $global_data_length; $i++ ) {
		push @code_set, $global_ref_codes_table->[0];
	}
	return \@code_set;
}

sub codes_xor {
	my $ref_code_1 = shift @_;
	my $ref_code_2 = shift @_;
	my @code;
	for ( my $i = 0; $i < $global_code_length ; $i++ ) {
		if ( $ref_code_1->[$i] != $ref_code_2->[$i] ) {
			push @code, 1;
		} else {
			push @code, 0;
		}
	}
	return \@code;
}


sub table2text {
	my $ref_codes_table = shift @_;
	my $text;
	foreach my $ref_code ( @$ref_codes_table ) {
		$text .= &code2string( $ref_code ) . "\n";
	}
	return $text;
}

sub code2string {
	my $ref_code = shift @_;
	my @code = @$ref_code;
	my $str = "";
	foreach my $bit ( @code ) {
		$str .= $bit;
	}
	return $str;
}

sub get_codes_table {
	my @table;
	for ( my $i = 0; $i < 2**$global_code_length; $i++ ) {
		my @code = @{&int2code($i)};
		my $str = &code2string( \@code );
		if ( &code_num_of_bits( \@code ) == $global_number_of_alone_bits_in_code &&
		     &if_code_alone_bits( \@code ) ) {
			push @table, \@code;
		}
	}
	return \@table;
}

sub if_code_alone_bits { # returns 1 if there are no adjacent "1" bits
	my $ref_code = shift @_;
	my @code = @{$ref_code};
	for ( my $i = 0; $i < $global_code_length - 1; $i++ ) {
		if ( $code[$i] && $code[$i+1] ) {
			return 0;
		}
	}
	return 1;
}

sub code_num_of_bits { # how many bits = 1
	my $ref_code = shift @_;
	my @code = @{$ref_code};
	my $num = 0;
	foreach my $bit ( @code ) {
			$num += $bit;
	}
	return $num;
}


sub get_zero_code {
	my @code;
	for ( my $i = 0; $i < $global_code_length; $i++ ) {
		push @code, 0;
	}
	return \@code;
}

sub get_next_code {
	my $ref_code = shift @_;
	my @code = @{$ref_code};
	my $carry = 1;
	for ( my $i = $global_code_length - 1; $i >=0; $i-- ) {
		my $carry_next = int ( $code[$i] + $carry ) / 2;
		$code[$i] = ( $code[$i] + $carry ) % 2;
		$carry = $carry_next;
	}
	return \ @code;
}

sub code2int {
	my $ref_code = shift @_;
	my @code = @{$ref_code};
	my $int = 0;
	my $weight = 2**$#code;
	foreach my $bit ( @code ) {
		$int = $int + $bit * $weight;
		$weight = $weight / 2;
	}
	return $int;
}

sub int2code {
	my $int = shift @_;
	my @code;
	for ( my $i = $global_code_length - 1; $i >= 0; $i-- ) {
		my $weight = 2**$i;
		if ( $weight <= $int ) {
			push @code, 1;
			$int = $int - $weight;
		} else {
			push @code, 0;
		}
	}
	return \ @code;
}















